home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / complxo.exe / CDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-01-15  |  13KB  |  412 lines

  1. {$N+,E+}
  2. PROGRAM cdemo;
  3.  
  4.  {This PROGRAM demonstrates the use of the ComplexOps UNIT.
  5.  
  6.   (C) Copyright 1990, 1992, Earl F. Glynn, Overland Park, KS.  Compuserve 73257,3527.
  7.   All rights reserved.  This program may be freely distributed only for
  8.   non-commercial use.}
  9.  
  10.  
  11.   USES ComplexOps;
  12.  
  13.   VAR
  14.     a      :  ARRAY[1..22] OF Complex;
  15.     csave  :  ARRAY[1..22] OF Complex;
  16.     k,m    :  WORD;
  17.     n      :  INTEGER;
  18.     x,y    :  RealType;
  19.     z,z1,z2:  Complex;
  20.  
  21. BEGIN
  22.  
  23.   WRITELN ('Demo ComplexOPs PROCEDUREs and FUNCTIONs');
  24.   WRITELN;
  25.   WRITELN ('  Notes:  1.  CIS(w) = COS(w) + i*SIN(w), w = -PI..PI');
  26.   WRITELN ('          2.  z = x + i*y');
  27.   WRITELN;
  28.   WRITELN;
  29.  
  30.   CSet (a[ 1],  0.0,  0.0, rectangular);
  31.   CSet (a[ 2],  0.5,  0.5, rectangular);
  32.   CSet (a[ 3], -0.5,  0.5, rectangular);
  33.   CSet (a[ 4], -0.5, -0.5, rectangular);
  34.   CSet (a[ 5],  0.5, -0.5, rectangular);
  35.   CSet (a[ 6],  1.0,  0.0, rectangular);
  36.   CSet (a[ 7],  1.0,  1.0, rectangular);
  37.   CSet (a[ 8],  0.0,  1.0, rectangular);
  38.   CSet (a[ 9], -1.0,  1.0, rectangular);
  39.   CSet (a[10], -1.0,  0.0, rectangular);
  40.   CSet (a[11], -1.0, -1.0, rectangular);
  41.   CSet (a[12],  0.0, -1.0, rectangular);
  42.   CSet (a[13],  1.0, -1.0, rectangular);
  43.   CSet (a[14],   5.,   0., rectangular);
  44.   CSet (a[15],   5.,   3., rectangular);
  45.   CSet (a[16],   0.,   3., rectangular);
  46.   CSet (a[17],  -5.,   3., rectangular);
  47.   CSet (a[18],  -5.,   0., rectangular);
  48.   CSet (a[19],  -5.,  -3., rectangular);
  49.   CSet (a[20],   0.,  -3., rectangular);
  50.   CSet (a[21],  -5.,  -3., rectangular);
  51.   CSet (a[22], -20.,  20., rectangular);
  52.  
  53.   WRITELN ('Complex number definition/conversion/output:  CSet/CConvert/CStr');
  54.   WRITELN;
  55.   WRITELN ('   z rectangular':25,'z polar':28);
  56.   WRITELN ('     ---------------------------   ',
  57.     '-----------------------------');
  58.   FOR k := 1 TO 21 DO
  59.     WRITELN (k:3,'  ',CStr(a[k],12,8,rectangular),'  ',
  60.                      CStr(a[k],12,8,polar));
  61.   WRITELN;
  62.   WRITELN;
  63.  
  64.   WRITELN ('Complex arithmetic:  CAdd, CSub, CMult, CDiv');
  65.   WRITELN;
  66.  
  67.   CSet (z1,  1, 1, rectangular);
  68.   WRITELN ('Let z1 = ':12,CStr(z1,8,3,rectangular):20,' or ',
  69.                       CStr(z1,8,3,polar));
  70.   CSet (z2, SQRT(3), -1, rectangular);
  71.   WRITELN ('z2 = ':12,CStr(z2,8,3,rectangular):20,' or ',
  72.                       CStr(z2,8,3,polar));
  73.   WRITELN;
  74.  
  75.   CAdd  (z,z1,z2);
  76.   WRITELN ('z1 + z2 = ':12,CStr(z,8,3,rectangular):20,' or ',
  77.                            CStr(z,8,3,polar));
  78.  
  79.   CSub  (z,z1,z2);
  80.   WRITELN ('z1 - z2 = ':12,CStr(z,8,3,rectangular):20,' or ',
  81.                            CStr(z,8,3,polar));
  82.  
  83.   CMult (z,z1,z2);
  84.   WRITELN ('z1 * z2 = ':12,CStr(z,8,3,rectangular):20,' or ',
  85.                            CStr(z,8,3,polar));
  86.  
  87.   CDiv  (z,z1,z2);
  88.   WRITELN ('z1 / z2 = ':12,CStr(z,8,3,rectangular):20,' or ',
  89.                            CStr(z,8,3,polar));
  90.   WRITELN;
  91.   WRITELN;
  92.  
  93.   WRITELN ('Complex natural logarithm:  CLn = LN(z)');
  94.   WRITELN;
  95.   WRITELN ('  Notes:  1.  LN(z) is multivalued.');
  96.   WRITELN (' ':9,' 2.  Any multiple of 2*PI*i could be added to/',
  97.     'subtracted from LN(z).');
  98.   WRITELN (' ':9,' 3.  LN(1)=0; LN(-1)=PI*i; LN(+/-i)=+/-0.5*PI*i.');
  99.   WRITELN;
  100.   WRITELN ('LN(z)':35);
  101.   WRITELN ('z':11,'rectangular':27,'EXP( LN(z) ) = z':32);
  102.   WRITELN ('     ------------  ---------------------------  ',
  103.     '---------------------------');
  104.   FOR k := 1 TO 22 DO BEGIN
  105.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  106.     IF   CAbs(a[k]) = 0.0
  107.     THEN WRITELN ('undefined':18)
  108.     ELSE BEGIN
  109.       CLn (z,a[k]);
  110.       CExp (z1,z);
  111.       WRITELN (CStr(z,12,9,rectangular),'  ',CStr(z1,12,9,rectangular))
  112.     END
  113.   END;
  114.   WRITELN;
  115.   WRITELN;
  116.  
  117.   WRITELN ('Complex exponential:  CExp = EXP(z)');
  118.   WRITELN;
  119.   WRITELN ('EXP(z)':35);
  120.   WRITELN ('z':11,'rectangular':27,'LN( EXP(z) ) = z':32);
  121.   WRITELN ('     ------------  ---------------------------  ',
  122.     '---------------------------');
  123.   FOR k := 1 TO 22 DO BEGIN
  124.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  125.     CExp (z,a[k]);
  126.     CLn (z1,z);
  127.     IF   CAbs(z) > 10.0
  128.     THEN m := 7
  129.     ELSE m := 9;
  130.     WRITELN (CStr(z,12,m,rectangular),'  ',CStr(z1,12,m,rectangular))
  131.   END;
  132.   WRITELN;
  133.   WRITELN;
  134.  
  135.   WRITELN ('Complex power:  CPwr = z1^z2');
  136.   WRITELN;
  137.   WRITELN ('z^(-1+i)':36,'z^(-1+i)':29);
  138.   WRITELN ('z':11,'rectangular':27,'polar':26);
  139.   WRITELN ('     ------------  ---------------------------  ',
  140.     '-----------------------------');
  141.   CSet (z1, -1,1, rectangular);
  142.   FOR k := 1 TO 21 DO BEGIN
  143.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  144.     IF   CAbs(a[k]) = 0.0
  145.     THEN WRITELN ('undefined':18)
  146.     ELSE BEGIN
  147.       CPwr (z,a[k],z1);
  148.       WRITELN (CStr(z,12,9,rectangular),' ',CStr(z,12,9,polar))
  149.     END
  150.   END;
  151.   WRITELN;
  152.   WRITELN;
  153.  
  154.   WRITELN ('Complex cosine:  CCos = COS(z)');
  155.   WRITELN;
  156.   WRITELN ('COS(z)':35,'COS(z)':29);
  157.   WRITELN ('z':11,'rectangular':27,'polar':26);
  158.   WRITELN ('     ------------  ---------------------------  ',
  159.     '-----------------------------');
  160.   FOR k := 1 TO 21 DO BEGIN
  161.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  162.     CCos (z,a[k]);
  163.     CIntPwr (csave[k], z,2);  {save COS^2}
  164.     IF   CAbs(z) > 10.0
  165.     THEN m := 7
  166.     ELSE m := 9;
  167.     WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
  168.   END;
  169.   WRITELN;
  170.   WRITELN;
  171.  
  172.   WRITELN ('Complex sine:  CSin = SIN(z)');
  173.   WRITELN;
  174.   WRITELN ('SIN(z)':35);
  175.   WRITELN ('z':11,'rectangular':27,'SIN^2(z)+COS^2(z)=1':32);
  176.   WRITELN ('     ------------  ---------------------------  ',
  177.     '---------------------------');
  178.   FOR k := 1 TO 21 DO BEGIN
  179.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  180.     CSin (z,a[k]);
  181.     CIntPwr (z1, z,2);      {SIN^2}
  182.     CAdd (z1, z1,csave[k]); {SIN^2 + COS^2}
  183.     IF   CAbs(z) > 10.0
  184.     THEN m := 7
  185.     ELSE m := 9;
  186.     WRITELN (CStr(z,12,m,rectangular),'  ',CStr(z1,12,9,rectangular))
  187.   END;
  188.   WRITELN;
  189.   WRITELN;
  190.  
  191.   WRITELN ('Complex tangent:  CTan = TAN(z)');
  192.   WRITELN;
  193.   WRITELN ('TAN(z)':35,'TAN(z)':29);
  194.   WRITELN ('z':11,'rectangular':27,'polar':26);
  195.   WRITELN ('     ------------  ---------------------------  ',
  196.     '-----------------------------');
  197.   FOR k := 1 TO 21 DO BEGIN
  198.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  199.     CTan (z,a[k]);
  200.     IF   CAbs(z) > 10.0
  201.     THEN m := 7
  202.     ELSE m := 9;
  203.     WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
  204.   END;
  205.   WRITELN;
  206.   WRITELN;
  207.  
  208.   WRITELN ('Complex hyperbolic cosine:  CCosh = COSH(z)');
  209.   WRITELN;
  210.   WRITELN ('COSH(z)':36,'COSH(z)':29);
  211.   WRITELN ('z':11,'rectangular':27,'polar':26);
  212.   WRITELN ('     ------------  ---------------------------  ',
  213.     '-----------------------------');
  214.   FOR k := 1 TO 21 DO BEGIN
  215.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  216.     CCosh (z,a[k]);
  217.     CIntPwr (csave[k], z,2);  {save COSH^2}
  218.     IF   CAbs(z) > 10.0
  219.     THEN m := 7
  220.     ELSE m := 9;
  221.     WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
  222.   END;
  223.   WRITELN;
  224.   WRITELN;
  225.  
  226.   WRITELN ('Complex hyperbolic sine:  CSinh = SINH(z)');
  227.   WRITELN;
  228.   WRITELN ('SINH(z)':36);
  229.   WRITELN ('z':11,'rectangular':27,'COSH^2(z)-SINH^2(z)=1':34);
  230.   WRITELN ('     ------------  ---------------------------  ',
  231.     '---------------------------');
  232.   FOR k := 1 TO 21 DO BEGIN
  233.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  234.     CSinh (z,a[k]);
  235.     CIntPwr (z1, z,2);      {SINH^2}
  236.     CSub (z1, csave[k],z1); {COSH^2 - SINH^2}
  237.     IF   CAbs(z) > 10.0
  238.     THEN m := 7
  239.     ELSE m := 9;
  240.     WRITELN (CStr(z,12,m,rectangular),'  ',CStr(z1,12,9,rectangular))
  241.   END;
  242.   WRITELN;
  243.   WRITELN;
  244.  
  245.   WRITELN ('Complex hyperbolic tangent:  CTanh = TANH(z)');
  246.   WRITELN;
  247.   WRITELN ('TANH(z)':36,'TANH(z)':29);
  248.   WRITELN ('z':11,'rectangular':27,'polar':26);
  249.   WRITELN ('     ------------  ---------------------------  ',
  250.     '-----------------------------');
  251.   FOR k := 1 TO 21 DO BEGIN
  252.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  253.     CTanh (z,a[k]);
  254.     IF   CAbs(z) > 10.0
  255.     THEN m := 4
  256.     ELSE m := 9;
  257.     WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,po